home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 021-030 / amok26 / fileio / fileio.mod < prev    next >
Text File  |  1993-11-04  |  4KB  |  140 lines
  1. (*---------------------------------------------------------------------------
  2.     :Program.     FileIO.mod
  3.     :Contents.      komplette Files lesen und schreiben
  4.     :Author.      Bernd Preusing
  5.     :Address.      Gerhardstr. 16  D-2200 Elmshorn
  6.     :Phone.      04121/22486
  7.     :Copyright.      Public Domain
  8.     :Language.      Modula-2
  9.     :Translator.  M2Amiga V3.27d
  10.     :History.      1.0 14-Sep-89 Bernd Preusing
  11.     :History.      1.1 23-Sep-89 Bernd Preusing: neue PROCEDURE FreeFile
  12.     :History.        und Fehlermeldung in PutFile korrigiert.
  13.     :Bugs.      none
  14.     :Remark.      Dieses Modul war überfällig!
  15. ---------------------------------------------------------------------------*)
  16. IMPLEMENTATION MODULE FileIO;
  17.  
  18. (* from .def:
  19. TYPE
  20.   FileIOResult= (noError, notFound, readError, writeError, saveError,
  21.            noMem);
  22. *)
  23.  
  24. FROM SYSTEM    IMPORT    ADR, ADDRESS, CAST;
  25. FROM Arts    IMPORT    Assert;
  26. FROM Dos    IMPORT    oldFile, newFile, end, beginning, FileHandlePtr,
  27.             Close, DeleteFile, Open, Read, Rename, Seek, Write,
  28.             FileLockPtr, Lock, UnLock,
  29.             FileInfoBlock, FileInfoBlockPtr, Examine, sharedLock;
  30. FROM Heap    IMPORT    Allocate, Deallocate;
  31. FROM Str    IMPORT    Copy, Concat;
  32.  
  33.  
  34. TYPE
  35.  CharPtr = POINTER TO CHAR;
  36.  
  37.  
  38. VAR
  39.     NewName: ARRAY [0..79] OF CHAR; (* not too much stack! *)
  40.     Fib: FileInfoBlockPtr;
  41.  
  42.  
  43. (* test, if file exists, and is really a file *)
  44. PROCEDURE FileExists(VAR Name: ARRAY OF CHAR):BOOLEAN;
  45. VAR l:FileLockPtr;
  46. BEGIN
  47.   l:=Lock(ADR(Name),sharedLock);
  48.   IF l # NIL THEN
  49.     IF Examine(l,Fib) AND (Fib^.dirEntryType<0) THEN
  50.       UnLock(l);
  51.       RETURN TRUE;
  52.     ELSE
  53.       UnLock(l);
  54.       RETURN FALSE
  55.     END;
  56.   ELSE
  57.     RETURN FALSE
  58.   END;
  59. END FileExists;
  60.  
  61. (* load file, alloc buffer filelen+1+add, set 0C after end *)
  62. PROCEDURE GetFile(VAR Name:ARRAY OF CHAR; VAR Addr:ADDRESS;
  63.           VAR Len:LONGINT; Add:LONGINT):FileIOResult;
  64. VAR f: FileHandlePtr; actual:LONGINT; Buffer:CharPtr;
  65. BEGIN
  66.   f:=Open(ADR(Name),oldFile);
  67.   IF f # NIL THEN
  68.     actual:=Seek(f,0,end);
  69.     Len:=Seek(f,0,beginning);
  70.     IF Len<0 THEN
  71.       Close(f);
  72.       RETURN seekError
  73.     END;
  74.     Allocate(Buffer,Len+Add+1);
  75.     IF Buffer#NIL THEN
  76.       Addr:=Buffer;
  77.       actual:=Read(f,Buffer,Len);
  78.       IF (actual=Len) THEN
  79.     INC(Buffer,Len); Buffer^:=0C;
  80.     Close(f);
  81.     RETURN noError;
  82.       ELSE
  83.         Close(f);
  84.         Deallocate(Buffer);
  85.     RETURN readError
  86.       END;
  87.     ELSE
  88.       Close(f);
  89.       RETURN noMem;
  90.     END;
  91.   ELSE
  92.     RETURN notFound
  93.   END
  94. END GetFile;
  95.  
  96.  
  97. PROCEDURE FreeFile(VAR Buffer:ADDRESS);
  98. (* :Input.    Buffer: die mittels GetFile erhaltene Adresse
  99.    :Semantic.   Gibt den Speicher des FilePuffers wieder frei
  100. *)
  101. BEGIN
  102.   Deallocate(Buffer)
  103. END FreeFile;
  104.  
  105.  
  106. (* save file len, dealloc buffer on demand (only, if no error!!!),
  107.    keep backup ('Name.bak') on demand *)
  108. PROCEDURE PutFile(VAR Name:ARRAY OF CHAR; Buffer:ADDRESS;
  109.           Len:LONGINT; Backup, DeallocMem: BOOLEAN):FileIOResult;
  110. VAR f: FileHandlePtr; l: FileLockPtr; actual:LONGINT;
  111. BEGIN
  112.   IF Backup AND FileExists(Name) THEN
  113.     Copy(NewName,Name); Concat(NewName,'.bak');
  114.     IF FileExists(NewName) AND NOT DeleteFile(ADR(NewName)) THEN
  115.       RETURN renameError
  116.     END;
  117.     IF NOT Rename(ADR(Name),ADR(NewName)) THEN
  118.       RETURN renameError
  119.     END;
  120.   END; (* if backup *)
  121.   f:=Open(ADR(Name),newFile);
  122.   IF f#NIL THEN
  123.     actual:=Write(f,Buffer,Len);
  124.     Close(f);
  125.     IF (actual=Len) THEN
  126.       IF DeallocMem THEN Deallocate(Buffer) END;
  127.       RETURN noError;
  128.     ELSE
  129.       RETURN writeError
  130.     END;
  131.   ELSE
  132.     RETURN saveError
  133.   END
  134. END PutFile;
  135.  
  136. BEGIN
  137.   Allocate(Fib,SIZE(Fib^));
  138.   Assert(Fib#NIL,ADR('FileIO: no mem for FileInfoBlock'));
  139. END FileIO.mod
  140.